home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
tp256d.exe
/
SVGADEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-11-28
|
6KB
|
194 lines
{ Super VGA Demo Program }
{ Thomas Design }
{ August 11, 1989 }
uses
Graph,crt,
VGAEXTRA, { dacpalette(..) and flashmodes }
ISVGADET;
var
Gd, Gm : integer;
DAC : RGB; { DAC is a byte aligned array of char }
{------------- Hue Saturation & Intensity TO rgb -----------------}
procedure hsi2rgb(h,s,i: real; var Rvalue,Gvalue,Bvalue : integer);
var
t: real;
rv,gv,bv: real;
begin { procedure hsi2rgb }
t:=2*pi*h;
rv:=1+s*sin(t-2*pi/3);
gv:=1+s*sin(t);
bv:=1+s*sin(t+2*pi/3);
t:=63.999*i/2;
Rvalue:=trunc(rv*t);
Gvalue:=trunc(gv*t);
Bvalue:=trunc(bv*t);
end;
{------------- Load the inital color palette -----------------------}
procedure LoadPalette(HueStep: real;SatStep : real;IntenStep : real);
var index : integer;
h,s,i : real;
h1,s1,i1 : real;
r,g,b : integer;
begin
h1 := 1.0 / HueStep;
h := 0; { start with hue value of zero }
s := 1.00;
i := 1.00;
for index := 1 to 256 do begin
hsi2rgb(h,s,i,R,G,B); { compute RGB values using HSI }
DAC[index][0] := R; { load each RGB value into the array }
DAC[index][1] := G;
DAC[index][2] := B;
h := h + h1;
i := i - IntenStep;
s := s - SatStep;
end;
Dac[0][0] := 0; { Insure the background stays black }
Dac[0][1] := 0;
Dac[0][2] := 0;
dacpalette(DAC);
end;
{------------ Initialize the graphics system -----------------------}
procedure InitGraphics; { setup the SuperVGA driver }
var count : integer;
Error : integer;
begin
gd := InstallUserDriver('ISVGA256',@_DetectISVGA256); { must say gd := Install... to work }
gd := DETECT;
InitGraph(gd, gm ,''); { use the default graphics mode }
Error := GraphResult;
if Error <> grOK then { if SVGA driver not available, error! }
begin
Writeln('Graphics error: ', GraphErrorMsg(Error));
Halt(1);
end;
LoadPalette(32,0,0);
end;
{------------ use circles in graphics demo -------------------------}
procedure CirclePlay;
var
FillColor : integer;
MaxX, MaxY : integer;
MaxRadius : integer;
Xcenter,Ycenter : integer;
Ballx,Bally : integer;
Index : byte;
xincrement,yincrement : integer;
Testx,Testy : integer;
MirrorX,MirrorY : integer;
test : char;
begin
Maxradius := getmaxx div 35;
MaxX := getmaxx;
MaxY := getmaxy;
Xcenter := MaxX div 2;
Ycenter := MaxY div 2;
Ballx := Xcenter;
Bally := Ycenter;
xincrement := -Maxradius;
yincrement := -Maxradius;
randomize;
Index := 1;
repeat
SetColor(Index);
SetFillStyle(SOLIDFILL, Index);
FillEllipse(Ballx, Bally,Maxradius, Maxradius);
Testx := Ballx - Xcenter;
Testy := Bally - Ycenter;
MirrorX := -Testx + Xcenter;
FillEllipse(MirrorX,Bally,Maxradius, Maxradius);
MirrorY := -Testy + Ycenter;
FillEllipse(Ballx,MirrorY,Maxradius, Maxradius);
FillEllipse(MirrorX,MirrorY,Maxradius, Maxradius);
Ballx := Ballx + xincrement;
Bally := Bally + yincrement;
inc(Maxradius);
If ((Ballx <= 0) or (Ballx >= MaxX)) then begin
xincrement := xincrement * -1;
Maxradius := abs(xincrement);
end;
If ((Bally <= 0) or (Bally >= MaxY)) then begin
yincrement := yincrement * -1;
Maxradius := abs(xincrement);
end;
inc(index);
if (Index = 0) then begin
inc(Index);
LoadPalette(32,random/256,random/256);
Maxradius := getmaxx div (random(20) + 20);
end;
until KeyPressed;
cleardevice;
test := readkey;
end;
{------------ use bars in graphics demo -------------------------}
procedure BarPlay;
var
FillColor : integer;
MaxX, MaxY : integer;
Maxwidth : integer;
Xcenter,Ycenter : integer;
LocX,LocY : integer;
Index : byte;
xincrement,yincrement : integer;
Testx,Testy : integer;
MirrorX,MirrorY : integer;
test : char;
begin
Maxwidth := getmaxx div 100;
MaxX := getmaxx;
MaxY := getmaxy;
Xcenter := MaxX div 2;
Ycenter := MaxY div 2;
LocX := Xcenter;
LocY := Ycenter;
xincrement := -Maxwidth;
yincrement := -Maxwidth;
randomize;
Index := 1;
repeat
SetColor(Index);
SetFillStyle(SOLIDFILL, Index);
bar(LocX, LocY,LocX+Maxwidth, LocY+Maxwidth);
Testx := LocX - Xcenter;
Testy := LocY - Ycenter;
MirrorX := -Testx + Xcenter;
bar(MirrorX,LocY,MirrorX+Maxwidth, LocY+Maxwidth);
MirrorY := -Testy + Ycenter;
bar(LocX,MirrorY,LocX+Maxwidth, MirrorY+Maxwidth);
bar(MirrorX,MirrorY,MirrorX+Maxwidth, MirrorY+Maxwidth);
LocX := LocX + xincrement;
LocY := LocY + yincrement;
inc(Maxwidth);
If ((LocX <= 0) or (LocX >= MaxX)) then begin
xincrement := xincrement * -1;
Maxwidth := abs(xincrement);
end;
If ((LocY <= 0) or (LocY >= MaxY)) then begin
yincrement := yincrement * -1;
Maxwidth := abs(xincrement);
end;
inc(index);
if (Index = 0) then begin
inc(Index);
LoadPalette(32,random/256,random/256);
end;
until KeyPressed;
cleardevice;
test := readkey;
end;
begin
InitGraphics;
CirclePlay;
BarPlay;
restorecrtmode;
end.